home *** CD-ROM | disk | FTP | other *** search
/ Mac Power 1997 January / macpower199701.bin / AMUG / Publishing_19 / Alpha 6.5.sit / Tcl / Menus / thinkMenu.tcl < prev    next >
Encoding:
Text File  |  1996-08-15  |  8.2 KB  |  332 lines  |  [TEXT/ALFA]
  1. # (nowrap)
  2.  
  3. if $startingUp {
  4.     set thinkMenu         "･300"
  5.     addMenu thinkMenu
  6.     return
  7. }
  8.  
  9.  
  10.  
  11. proc thinkMenu {} {}
  12.  
  13. # The menu
  14. menu -n $thinkMenu {
  15.     "/S<O<Uthink"
  16.     "openHeader"
  17.     "menu -n thinkFlags {}"
  18.     "createThinkFileset"
  19.     "(-"
  20.     "/K<O<Ucompile"
  21.     "checkSyntax"
  22.     "/T<O<UsearchNextFile"
  23.     "(-"
  24.     "add"
  25.     "addAndCompile"
  26.     "(-"
  27.     "disassemble"
  28.     "preprocess"
  29.     "precompile"
  30.     "(-"
  31.     "bringUpToDate"
  32.     "/¥¥<O<Umake"
  33.     "(-"
  34.     "/I<O<Udebug"
  35.     "/R<O<Urun"
  36. }
  37.  
  38.  
  39. # The following flags affect Think's "Run" command.
  40. # THINK will crash if you set the debugger flag and your 
  41. # project does not have debugging information. 
  42. if {![info exists thinkdebugger]}     {set thinkdebugger     0}
  43. if {![info exists thinkgo]}         {set thinkgo         1}
  44. if {![info exists thinksaveDirty]}     {set thinksaveDirty    1}
  45. if {![info exists thinkupdate]}     {set thinkupdate     1}
  46.  
  47. menu -n thinkFlags -p thinkFlagsProc {"debugger" "go" "saveDirty" "update"}
  48. markMenuItem thinkFlags debugger     $thinkdebugger
  49. markMenuItem thinkFlags go             $thinkgo
  50. markMenuItem thinkFlags saveDirty    $thinksaveDirty
  51. markMenuItem thinkFlags update         $thinkupdate
  52.  
  53. proc thinkFlagsProc {menu item} {
  54.     global think$item modifiedVars
  55.     
  56.     set think$item [expr -1 * ([set think$item] - 1)]
  57.     markMenuItem thinkFlags $item [set think$item]
  58.     lappend modifiedVars think$item
  59. }
  60.  
  61. set THINK "THINK Project Manager"
  62. #set THINK "AEvent Display 1.3"
  63.  
  64.  
  65. proc thinkNumFiles {} {
  66.     global THINK
  67.     set str [AEBuild -r $THINK "core" "cnte" "----" {obj{want:type('PDOC'), from:'null'(), form:'indx', seld:1}} "kocl" "type('SFIL')"]
  68.     if {[regexp {[0-9]+} $str mtch]} {
  69.         return $mtch
  70.     } else {
  71.         error "Bad numfiles"
  72.     }
  73. }
  74.  
  75.  
  76.  
  77. # Get list of files in current project.
  78. proc projectFileList args {
  79.     global SymCompSig
  80.     watchCursor
  81.     launchBackAppl $SymCompSig
  82.     set num [thinkNumFiles]
  83.     set files {}
  84.  
  85.     for {set i 1} {$i<=$num} {incr i} {
  86.         set f [thinkFileName $i]
  87.         if {[getFileType $f] == "TEXT"} {
  88.             lappend files $f
  89.         }
  90.     }
  91.  
  92.     return $files
  93. }
  94.  
  95.  
  96.  
  97.  
  98. #================================================================================
  99.  
  100.  
  101. proc think {} {
  102.     global SymCompSig
  103.     launchForeAppl $SymCompSig
  104. }
  105.  
  106. proc searchNextFile {} {
  107.     thinkFinf
  108. }
  109.  
  110.  
  111.  
  112. #===========================================================================
  113. # Add fileset.
  114. #===========================================================================
  115. proc createThinkFileset {} {
  116.     global gfileSets gfileSetsType
  117.     
  118.     set name [prompt "Fileset name? " "THINK"]
  119.     set gfileSets($name) [lsort -command sortByTail [projectFileList]]
  120.     set gfileSetsType($name) think
  121.  
  122.     if {[askyesno "Save project fileset?"] == "yes"} {
  123.         addArrDef gfileSets $name  $gfileSets($name)
  124.     }
  125.     return $name
  126. }
  127.  
  128. #================================================================================
  129.  
  130. proc compile {} {
  131.     sendCompileEvent CMPL "-r"
  132. }
  133.  
  134. proc checkSyntax {} {
  135.     sendCompileEvent SNTX "-q"
  136. }
  137.  
  138. proc disassemble {} {
  139.     global THINK ALPHA SymCompSig
  140.     getApplSig "Please locate $THINK" SymCompSig
  141.     set tname [file tail [launchForeAppl $SymCompSig]]
  142.     set name [car [winNames -f]]
  143.     set res [AEBuild -t 7200 -r $tname KAHL DASM CFLG long(32) "----" [fileObject $name]]
  144.     switchTo $ALPHA
  145.     new -n "* [file root [file tail $name]].asm *"
  146.     regexp {ﾒ.*ﾓ} $res text
  147.     insertText [string trim $text {ﾒﾓ}]
  148.     setWinInfo dirty 0
  149.     goto 0
  150. }
  151.  
  152. proc preprocess {} {
  153.     global THINK ALPHA SymCompSig
  154.     getApplSig "Please locate $THINK" SymCompSig
  155.     set tname [file tail [launchForeAppl $SymCompSig]]
  156.     set name [car [winNames -f]]
  157.     set res [AEBuild -r $tname KAHL PRCS CFLG long(32) "----" [fileObject $name]]
  158.     switchTo $ALPHA
  159.     new -n "* Preprocessed '[file tail $name]' *"
  160.     regexp {ﾒ.*ﾓ} $res text
  161.     insertText [string trim $text {ﾒﾓ}]
  162. }
  163.  
  164.  
  165. proc sendCompileEvent {event arg} {
  166.     global THINK ALPHA SymCompSig
  167.  
  168.     getApplSig "Please locate $THINK" SymCompSig
  169.     set tname [file tail [launchForeAppl $SymCompSig]]
  170.     set name [car [winNames -f]]
  171.     if {[string length $arg]} {
  172.         set err [catch {AEBuild -t 7200 $arg $tname KAHL  $event "----" [fileObject $name]} res]
  173.     } else {
  174.         set err [catch {AEBuild -t 7200 $tname KAHL  $event "----" [fileObject $name]} res]
  175.     }
  176.     if (!$err) {
  177.         set err [catch {switchTo $ALPHA} res]
  178.     }
  179.     if ($err) {
  180.         message $res
  181.     } else {
  182.         return $res
  183.     }
  184. }
  185.  
  186.  
  187. proc add {} {
  188.     global THINK
  189.     set fname [car [winNames -f]]
  190.     AEBuild $THINK core crel "data" [makeAlis $fname] "kocl" "type('SFIL')"
  191. }
  192.  
  193. proc addAndCompile {} {
  194.     add
  195.     compile
  196. }
  197.  
  198.  
  199. proc precompile {} {
  200.     sendCompileEvent PCMP ""
  201. }
  202.  
  203. proc bringUpToDate {} {
  204.     global THINK ALPHA SymCompSig
  205.     getApplSig "Please locate $THINK" SymCompSig
  206.     set name [file tail [launchForeAppl $SymCompSig]]
  207.     set res [AEBuild -q $name KAHL CMPL SLCT MAKE "CFLG" "long(2)" "----" {obj{want:type('PDOC'), from:'null'(), form:'indx', seld:1}}] 
  208.     switchTo $ALPHA
  209.     return $res
  210. }
  211.  
  212. proc make {} {
  213.     global THINK ALPHA SymCompSig
  214.     getApplSig "Please locate $THINK" SymCompSig
  215.     set name [file tail [launchForeAppl $SymCompSig]]
  216.     set res [AEBuild -q $name KAHL CMPL SLCT MAKE "CFLG" "long(2)" "----" {obj{want:type('PDOC'), from:'null'(), form:'indx', seld:1}}] 
  217. }
  218.  
  219. proc run {} {
  220.     global THINK thinkdebugger thinkgo thinksaveDirty thinkupdate SymCompSig
  221.     
  222.     set dbug [expr {$thinkdebugger ? "bool(ﾇ01ﾈ)" : "bool(ﾇ00ﾈ)"}]
  223.     set go [expr {$thinkgo ? "bool(ﾇ01ﾈ)" : "bool(ﾇ00ﾈ)"}]
  224.     set update [expr {$thinkupdate ? "'yes '" : "'no  '"}]
  225.     set dirty [expr {$thinksaveDirty ? "'yes '" : "'no  '"}]
  226.     getApplSig "Please locate $THINK" SymCompSig
  227.     set name [file tail [launchForeAppl $SymCompSig]]
  228.     if {[catch {AEBuild -q $name KAHL "RUN " "DBUG" $dbug  "GO  " $go "UPDT" $update "savo" $dirty} res]} {
  229.         message $res
  230.     }
  231. }
  232.  
  233. proc debug {} {
  234.     global THINK 
  235.     switchTo 'ﾗLSD'
  236.     set fname [car [winNames -f]]
  237.     set row [expr [lindex [posToRowCol [getPos]] 0] - 1]
  238.     if {[catch {AEBuild $THINK KAHL DBGF "----" [makeAlis $fname] LNNO "short($row)" } res]} {
  239.         message $res
  240.     }
  241. }
  242.  
  243. proc cnt {} {
  244.     global THINK
  245.     AEBuild -t 6000 -r $THINK core cnte "----" {obj{want:type('PDOC'), from:'null'(), form:'indx', seld:1}} "kocl" "type('sfil')"
  246. }
  247.  
  248. proc thinkFileName {arg} {
  249.     global THINK
  250.     set event [join [concat {obj¥ ¥{want:type('prop'),¥ from:obj¥ ¥{want:type('SFIL'),¥ from:'null'(),¥ form:'indx',¥ seld:} $arg {¥},¥ form:'prop',¥ seld:type('FSS¥ ')¥}}] ""]
  251.     set blah [AEBuild -r $THINK "core" "getd"  "----" $event]
  252.     regexp {ﾇ.*ﾈ} $blah blah
  253.     return [specToPathName [string trim $blah {ﾇﾈ}]]
  254. }
  255.  
  256. proc thinkInclude {name} {
  257.     global THINK thinkpaths
  258.     if {[info exists thinkpaths]} {unset thinkpaths}
  259.     set event [join [concat {obj¥ ¥{want:type('prop'),¥ from:obj¥ ¥{want:type('SFIL'),¥ from:'null'(),¥ form:'name', seld:ﾒ} [file tail $name] {ﾓ¥},¥ form:'prop',¥ seld:type('INCL')¥}}] ""]
  260.     set blah [AEBuild -r $THINK "core" "getd"  "----" $event]
  261.     if {![regexp {ﾇ} $blah]} {return {{(No includes}}}
  262.     regsub -all {ﾈ[^ﾇ]*ﾇ} $blah { } raw
  263.     regsub {[^ﾇ]*ﾇ} $raw {} raw
  264.     regsub {ﾈ.*} $raw {} raw
  265.     foreach f $raw {
  266.         set path [specToPathName $f]
  267.         set tl [file tail $path]
  268.         set thinkpaths($tl) $path
  269.         lappend names $tl
  270.     }
  271.     return [lsort -ignore $names]
  272. }
  273.  
  274. # Called by Alpha to get list of include files for popup.
  275. proc thinkGetIncludeFiles {} {
  276.     if {[catch {thinkInclude [lindex [winNames] 0]} ret]} {
  277.         return {{(* THINK not running *}}
  278.     }
  279.     return $ret
  280. }
  281.  
  282. # Called by Alpha to edit result of popup
  283. proc thinkEditIncludeFile {name} {
  284.     global thinkpaths
  285.     
  286.     edit $thinkpaths($name)
  287. }
  288.  
  289. proc openHeader {} {
  290.     global thinkpaths
  291.  
  292.     set name [lindex [winNames] 0]
  293.     if {![string length $name]} return
  294.     if {[catch {thinkInclude $name} names]} {
  295.         message "Think not running!" 
  296.         beep
  297.         return
  298.     }
  299.     if {![string length $name] || [string match {(*} [lindex $names 0]]} {
  300.         message "No headers."
  301.         beep
  302.         return
  303.     }
  304.     set res [listpick -p {Include File?} $names]
  305.     if {[string length $res]} {edit $thinkpaths($res)}
  306. }
  307.         
  308.  
  309. #================================================================================
  310.         
  311. proc handleThinkReply { l } {
  312.     global thinkErrors teIndex ALPHA tileLeft tileTop tileWidth tileHeight winModes terrMenu errorHeight
  313.     set thinkErrors $l
  314.     switchTo $ALPHA
  315.     set teIndex 0
  316.     
  317.     foreach err $l {
  318.         append lines "¥"[file tail [lindex $err 0]]¥"; " [format "Line %d: " [lindex $err 2]] [lindex $err 1] "¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥tｰ[lindex $err 0]ｰ[lindex $err 1]¥r"
  319.     }
  320.  
  321.     new -n "* Compiler Errors *" -g $tileLeft $tileTop $tileWidth $errorHeight
  322.  
  323.     insertText "(<cr> to go to error)¥r-----¥r" $lines
  324.     downBrowse
  325.     setWinInfo dirty 0
  326.     
  327.     global winModes
  328.     set name [lindex [winNames] 0]
  329.     changeMode [set winModes($name) Brws]
  330. }
  331.  
  332.